home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / games / kids / fouryrs.zoo / tile2.lst < prev    next >
File List  |  1993-02-21  |  3KB  |  149 lines
  1. ' tile2
  2. ' Programmed by Seymour Shlien in GFA Basic 3.5
  3. ' 624 Courtenay Avenue
  4. ' Ottawa, Ontario
  5. ' Canada
  6. ' Feb 21 1993
  7. rez%=XBIOS(4)
  8. IF rez%<>0
  9.   ALERT 3," Please switch   to | low  resolution! ",1,"Oops",b%
  10.   STOP
  11. ENDIF
  12. DEFMOUSE 0
  13. nx_grid%=24
  14. ny_grid%=24
  15. nx_space%=6
  16. ny_space%=6
  17. x_left%=10
  18. x_right%=x_left%+nx_grid%*nx_space%
  19. y_top%=48
  20. y_bot%=y_top%+ny_grid%*ny_space%
  21. col%=0
  22. DIM deskcolors%(16)
  23. @get_deskcolors
  24. @initialize_lut
  25. @instructions
  26. @color_bar
  27. @draw_grid
  28. col%=1
  29. REPEAT
  30.   IF MOUSEK<>0
  31.     IF MOUSEY>y_top% AND MOUSEX>x_left%
  32.       ix%=((MOUSEX-x_left%) DIV nx_space%)
  33.       iy%=((MOUSEY-y_top%) DIV ny_space%)
  34.       COLOR (col%)
  35.       IF ix%<nx_grid%
  36.         IF iy%<ny_grid%
  37.           PLOT ix%+x_right%+10,iy%+y_top%-10
  38.         ENDIF
  39.       ENDIF
  40.       ix%=ix%*nx_space%+x_left%
  41.       iy%=iy%*ny_space%+y_top%
  42.       @put_tiles(ix%,iy%,col%)
  43.       INC numpnts%
  44.     ELSE IF MOUSEX<180 AND MOUSEY<24
  45.       col%=MOUSEX/20+8*(MOUSEY DIV 16)
  46.     ELSE IF MOUSEX<230 AND MOUSEY<20
  47.       DEFFILL 0
  48.       PBOX x_left%,y_top%,x_right%,y_bot%
  49.       @draw_grid
  50.       PAUSE 10
  51.     ENDIF
  52.     IF (numpnts% MOD 50)=0
  53.       @make_lattice
  54.     ENDIF
  55.   ENDIF
  56. UNTIL ((MOUSEK<>0) AND (MOUSEX>238) AND (MOUSEY<20))
  57. @restore_deskcolors
  58. > PROCEDURE initialize_lut
  59.   VSETCOLOR 0,14,14,14
  60.   VSETCOLOR 1,0,0,0
  61.   VSETCOLOR 2,14,0,0
  62.   VSETCOLOR 3,0,12,0
  63.   VSETCOLOR 4,0,0,14
  64.   VSETCOLOR 5,10,10,14
  65.   VSETCOLOR 6,10,10,0
  66.   VSETCOLOR 7,10,0,10
  67.   VSETCOLOR 8,0,10,10
  68.   VSETCOLOR 9,14,14,0
  69.   VSETCOLOR 10,14,0,14
  70.   VSETCOLOR 11,0,14,14
  71.   VSETCOLOR 12,8,8,8
  72.   VSETCOLOR 13,10,10,10
  73.   VSETCOLOR 14,14,10,10
  74.   VSETCOLOR 15,10,14,10
  75. RETURN
  76. > PROCEDURE make_lattice
  77.   LOCAL i%,j%
  78.   GET x_right%+10,y_top%-10,x_right%+nx_grid%+9,y_top%+ny_grid%-10,cell$
  79.   FOR i%=0 TO 4
  80.     FOR j%=0 TO 5
  81.       PUT x_right%+40+i%*nx_grid%,y_top%+j%*ny_grid%,cell$
  82.     NEXT j%
  83.   NEXT i%
  84. RETURN
  85. > PROCEDURE draw_grid
  86.   DEFFILL 0
  87.   PBOX 0,30,319,199
  88.   DEFFILL col%
  89.   PBOX x_right%+10,y_top%-10,x_right%+nx_grid%+10,y_top%+ny_grid%-10
  90.   PBOX x_left%,y_top%,x_left%+nx_space%*nx_grid%,y_top%+ny_space%*ny_grid%
  91.   COLOR 1
  92.   BOX x_left%-1,y_top%-1,x_left%+nx_space%*nx_grid%+1,y_top%+ny_space%*ny_grid%+1
  93.   BOX x_left%,y_top%,x_left%+nx_space%*nx_grid%,y_top%+ny_space%*ny_grid%
  94.   BOX x_right%+39,y_top%-1,x_right%+40+nx_grid%*5,y_top%+6*ny_grid%+1
  95.   numpnts%=0
  96. RETURN
  97. > PROCEDURE put_tiles(ix%,iy%,col%)
  98.   DEFFILL col%
  99.   IF ix%<x_right%
  100.     IF iy%<y_bot%
  101.       PBOX ix%,iy%,ix%+nx_space%-1,iy%+ny_space%-1
  102.     ENDIF
  103.   ENDIF
  104. RETURN
  105. > PROCEDURE color_bar
  106.   CLS
  107.   FOR i%=0 TO 15
  108.     DEFFILL i%
  109.     PBOX (i% MOD 8)*20,8*(i% DIV 8)+8,((i% MOD 8)+1)*20,8*(i% DIV 8)+16
  110.   NEXT i%
  111.   FOR i%=0 TO 15
  112.     BOX (i% MOD 8)*20,8*(i% DIV 8)+8,((i% MOD 8)+1)*20,8*(i% DIV 8)+16
  113.   NEXT i%
  114.   COLOR 1
  115.   BOX 0,8,20,16
  116.   DEFTEXT 1
  117.   BOX 182,8,238,20
  118.   TEXT 184,18,"CLEAR"
  119.   BOX 238,8,280,20
  120.   TEXT 240,18,"QUIT"
  121.   DEFFILL 0
  122.   PBOX 0,40,319,199
  123.   DEFMOUSE 0
  124. RETURN
  125. > PROCEDURE get_deskcolors
  126.   LOCAL i%
  127.   FOR i%=0 TO 15
  128.     deskcolors%(i%)=XBIOS(7,i%,-1)
  129.   NEXT i%
  130. RETURN
  131. > PROCEDURE restore_deskcolors
  132.   LOCAL i%
  133.   FOR i%=0 TO 15
  134.     SETCOLOR i%,deskcolors%(i%)
  135.   NEXT i%
  136. RETURN
  137. > PROCEDURE instructions
  138.   DEFTEXT 1
  139.   CLS
  140.   PRINT "Click on colour and"
  141.   PRINT "draw in left square"
  142.   PRINT "holding down the mouse"
  143.   PRINT "button."
  144.   PRINT
  145.   PRINT "Click any mouse button to continue"
  146.   REPEAT
  147.   UNTIL MOUSEK<>0
  148. RETURN
  149.